home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / gt_power / escrub.zip / EMERGE.PAS < prev    next >
Pascal/Delphi Source File  |  1989-12-01  |  5KB  |  159 lines
  1. {$C-,V-,K-,R-,U-}
  2. {$G512,P512,D-}
  3. (****************************************************************************)
  4. (*                                                                          *)
  5. (*                         P & M  Software Company                          *)
  6. (*                         3104 E. Camelback Rd. #503                       *)
  7. (*                         Phoenix, Arizona 85016                           *)
  8. (*                                                                          *)
  9. (*                         November 15, 1989                                *)
  10. (*                                                                          *)
  11. (****************************************************************************)
  12. (*                                                                          *)
  13. (*                        USES MAX HEAP OF $2000                            *)
  14. (*                                                                          *)
  15. (****************************************************************************)
  16.  
  17. PROGRAM
  18.    emerge;
  19. TYPE
  20.    CHARACTERS           = STRING[255];
  21.    KEYTYPE              = STRING[7];
  22. CONST
  23.    high_values          : KEYTYPE = #$FF#$FF#$FF#$FF#$FF#$FF#$FF;
  24. VAR
  25.    infile1_name         : CHARACTERS;
  26.    infile2_name         : CHARACTERS;
  27.    outfile_name         : CHARACTERS;
  28.    infile1,infile2      : text[$2000];
  29.    outfile              : text[$2000];
  30.    infile1_rec          : CHARACTERS;
  31.    infile1_key          : KEYTYPE;
  32.    infile2_rec          : CHARACTERS;
  33.    infile2_key          : KEYTYPE;
  34.    error_stop           : INTEGER;
  35.  
  36.    PROCEDURE
  37.       UpString(VAR s    : CHARACTERS);
  38.    VAR
  39.       i                 : INTEGER;
  40.    BEGIN
  41.       FOR i:=1 TO Length(s) DO
  42.          s[i] := upcase(s[i]);
  43.    END;
  44.  
  45.    PROCEDURE
  46.       read_file_1;
  47.    BEGIN
  48.       IF (eof(infile1)) THEN BEGIN
  49.          infile1_key := high_values;
  50.          exit;
  51.       END;
  52.       readln(infile1,infile1_rec);
  53.       infile1_rec[9]:=' ';
  54.       infile1_key := copy(infile1_rec,1,7);
  55.    END;
  56.  
  57.    PROCEDURE
  58.       read_file_2;
  59.    BEGIN
  60.       IF (eof(infile2)) THEN BEGIN
  61.          infile2_key := high_values;
  62.          exit;
  63.       END;
  64.       readln(infile2,infile2_rec);
  65.       infile2_rec[9]:=' ';
  66.       infile2_key := copy(infile2_rec,1,7);
  67.    END;
  68.  
  69.    PROCEDURE
  70.       badfilename(VAR fn  : CHARACTERS);
  71.    BEGIN
  72.       writeln('ERROR: cannot open ',fn,' for input');
  73.    END;
  74.  
  75.    PROCEDURE
  76.       write_rec_out(k : INTEGER; VAR rc : CHARACTERS);
  77.    BEGIN
  78.       IF (k <> 0) THEN rc[9]:='·';
  79.       writeln(outfile,rc);
  80.    END;
  81.  
  82. LABEL
  83.    M1loop, M1read;
  84. VAR
  85.    k    : INTEGER;
  86.    knew : INTEGER;
  87. BEGIN
  88.    lowvideo;
  89.    writeln('EMERGE Version 001');
  90.    writeln;
  91.    flush(output);
  92.    error_stop := 0;
  93.    IF (ParamCount < 2) THEN BEGIN
  94.       writeln('ERROR: too few command line arguments');
  95.       writeln('       The correct syntax is: EMERGE infile1 infile2 outfile');
  96.       flush(output);
  97.       halt(1);
  98.    END;
  99.    infile1_name := ParamStr(1);
  100.    UpString(infile1_name);
  101.    infile2_name := ParamStr(2);
  102.    UpString(infile2_name);
  103.    outfile_name := ParamStr(3);
  104.    UpString(outfile_name);
  105.    assign(infile1,infile1_name);
  106.    {$I-}
  107.    reset(infile1);
  108.    {$I+}
  109.    IF (IOresult <> 0) THEN BEGIN
  110.       badfilename(infile1_name);
  111.       error_stop := 1;
  112.    END;
  113.    assign(infile2,infile2_name);
  114.    {$I-}
  115.    reset(infile2);
  116.    {$I+}
  117.    IF (IOresult <> 0) THEN BEGIN
  118.       badfilename(infile2_name);
  119.       error_stop := 1;
  120.    END;
  121.    assign(outfile,outfile_name);
  122.    {$I-}
  123.    rewrite(outfile);
  124.    {$I+}
  125.    IF (IOresult <> 0) THEN BEGIN
  126.       writeln('ERROR: cannot open ',outfile_name,' for output');
  127.       error_stop := 1;
  128.    END;
  129.    flush(output);
  130.    IF (error_stop <> 0) THEN
  131.       halt(1);
  132.    read_file_1;
  133.    read_file_2;
  134.    WHILE ((infile1_key <> high_values) OR (infile2_key <> high_values)) DO BEGIN
  135.        IF (infile1_key < infile2_key) THEN BEGIN
  136.            write_rec_out(1,infile1_rec);
  137.            read_file_1;
  138.            goto M1loop;
  139.        END;
  140.        IF (infile1_key > infile2_key) THEN BEGIN
  141.            write_rec_out(0,infile2_rec);
  142.            read_file_2;
  143.            goto M1loop;
  144.        END;
  145.        knew:=0;
  146.        IF (infile1_rec <> infile2_rec) THEN
  147.            knew:=1;
  148.        write_rec_out(knew,infile1_rec);
  149. M1read:
  150.        read_file_1;
  151.        read_file_2;
  152. M1loop:
  153.        ;
  154.    END;
  155.    close(infile1);
  156.    close(infile2);
  157.    close(outfile);
  158. END.
  159.